home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.02 Feb 88 / pascal sources / simple equation solver / Quad Main < prev    next >
Encoding:
Text File  |  1988-01-01  |  3.1 KB  |  138 lines  |  [TEXT/PJMM]
  1. { Quadratic Equation Example program    }
  2. { By Dave Kelly                            }
  3. { with mods by Dave Smith                }
  4. { ©MacTutor, 1988                        }
  5.  
  6. PROGRAM quadexample;
  7.  
  8. {$I-}
  9.  
  10.     USES
  11.         PlotGlobals;
  12.  
  13.  
  14.     FUNCTION positivecalc (a, b, check : real) : real;
  15.     BEGIN
  16.         positivecalc := (-b + sqrt(check)) / (2 * a);
  17.     END;
  18.  
  19.     FUNCTION negativecalc (a, b, check : real) : real;
  20.     BEGIN
  21.         negativecalc := (-b - sqrt(check)) / (2 * a);
  22.     END;
  23.  
  24.     PROCEDURE quad (a, b, c : real;
  25.                                     VAR x1, x2 : real;
  26.                                     VAR result : integer);
  27.         VAR
  28.             check : real;
  29.     BEGIN
  30.         result := 0;
  31.         check := (b * b) - (4 * a * c);
  32.         IF result = 0 THEN
  33.             BEGIN
  34.          { Check if double root exists }
  35.                 IF check = 0 THEN
  36.                     BEGIN
  37.                         result := 2;
  38.                         x1 := positivecalc(a, b, check);
  39.                     END;
  40.                 IF check > 0 THEN
  41.                     BEGIN
  42.                         result := 1;
  43.                         x1 := positivecalc(a, b, check);
  44.                         x2 := negativecalc(a, b, check);
  45.                     END;
  46.         { Check if root is complex }
  47.                 IF check < 0 THEN
  48.                     BEGIN
  49.                         result := 3;
  50.                         check := -check;
  51.                         x1 := positivecalc(a, b, check);
  52.                         x2 := negativecalc(a, b, check);
  53.                     END;
  54.             END;
  55.     END;
  56.  
  57.     PROCEDURE plotit (a, b, c, step : real;
  58.                                     xscale, yscale : integer);
  59.         VAR
  60.             hPos, vPos, hor, ver : integer;
  61.             x, y : real;
  62.             grafwrect, localrect : rect;
  63.     BEGIN
  64.         showdrawing;
  65.         getdrawingrect(grafwrect);
  66.         hor := (grafwrect.right - grafwrect.left) DIV 2;
  67.         ver := (grafwrect.bottom - grafwrect.top) DIV 2;
  68.         setrect(localrect, 0, 0, hor + hor, ver + ver);
  69.         EraseRect(localrect);
  70.         moveto(0, ver);
  71.         line(hor + hor, 0);
  72.         moveto(hor, 0);
  73.         line(0, ver + ver);
  74.         x := -xscale / 2;
  75.         y := a * x * x + (b * x) + c;
  76.         hPos := integer(round(x * hor * 2 / xscale + hor));
  77.         vPos := integer(round(-y * ver * 2 / yscale + ver));
  78.         moveto(hPos, vPos);
  79.         PenNormal;
  80.         REPEAT
  81.             x := x + step;
  82.             y := a * x * x + (b * x) + c;
  83.             hPos := integer(round(x * hor * 2 / xscale + hor));
  84.             vPos := integer(round(-y * ver * 2 / yscale + ver));
  85.             LineTo(hPos, vPos);
  86.         UNTIL x >= xscale / 2;
  87.     END;
  88.  
  89.     FUNCTION solveit : integer;
  90.     BEGIN
  91.         showtext;
  92.         write('Enter value for variable a ( 0 to quit) :');
  93.         readln(a);
  94.         IF a <> 0 THEN
  95.             BEGIN
  96.                 write('Enter value for variable b :');
  97.                 readln(b);
  98.                 write('Enter value for variable c :');
  99.                 readln(c);
  100.                 quad(a, b, c, x1, x2, result);
  101.                 writeln('a= ', a : 10 : 4, ' b= ', b : 10 : 4, ' c=', c : 10 : 4);
  102.             END
  103.         ELSE
  104.             result := -1;
  105.         IF result = -1 THEN
  106.             writeln('Data is not a quadratic equation or is illegal')
  107.         ELSE IF result = 3 THEN
  108.             BEGIN
  109.                 writeln('Root is complex!');
  110.                 writeln('x1= ', x1 : 10 : 4, ' x2= ', x2 : 10 : 4);
  111.             END
  112.         ELSE IF result = 2 THEN
  113.             writeln('Double Root = ', x1 : 10 : 4)
  114.         ELSE
  115.             BEGIN
  116.                 writeln('x1= ', x1 : 10 : 4, ' x2= ', x2 : 10 : 4);
  117.                 writeln('');
  118.             END;
  119.         solveit := result;
  120.     END;
  121.  
  122. { Main Program}
  123.  
  124. BEGIN
  125.     step := 0.005;
  126.     xscale := 20;
  127.     yscale := 400;
  128.     setrect(WindowRect, 25, 50, 400, 250);
  129.     setrect(PlotWindowRect, 100, 200, 600, 450);
  130.     settextrect(WindowRect);
  131.     setdrawingrect(PlotWindowRect);
  132.     REPEAT
  133.         result := solveit;
  134.         IF result <> -1 THEN
  135.             plotit(a, b, c, step, xscale, yscale);
  136.     UNTIL result = -1;
  137.     writeln('Program is terminating');
  138. END.